home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
stsim2.zip
/
STOCK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-01
|
7KB
|
353 lines
uses crt,menu,graph,sunit;
{ type
date = record
month:byte;
day:byte;
year:word;
end;
dayptr = ^day;
day = record
price:real;
thing:integer;
1 to 9999 is stock,
0 is player
-99 is stock market average.
next:dayptr;
end;
stock = record
symbol : string[3];
shares : integer;
end;
company = record
name : string;
symbol : string[3];
cash : real;
stock_price : real;
end;
var
universal_date:date;
first_one,current:dayptr;
co:array[1..20] of company;
tmp_month:integer;
num_co:integer;
_flash:integer;
_flash_str:string;
}
type
rplayer = record
stock:array[1..10] of stock;
num_stock:integer;
cash:real;
end;
var
num_rec:integer;
cur_month:integer;
player:rplayer;
procedure transact;forward;
procedure del_r(var d:dayptr);
var x:dayptr;
begin
x:=d;
d:=d^.next;
dispose(x);
end;
function stock_sum:real;forward;
function dow_jones:real;
var
total:real; i:integer;
begin
total:=0;
for i:=1 to num_co do begin
total:=total+co[i].stock_price;
end;
dow_jones:=total / num_co;
end;
procedure date_add;
var i:integer;
begin
with universal_date do
begin
inc(day);
if day>30 then begin
day:=1;
inc(month);
end;
if month>12 then begin
month:=1;
inc(year);
end;
gotoxy(70,3); write(month:2,'/',day:2,'/',year:4);
end;
for i:=1 to num_co do begin
with current^ do begin
thing:=i;
price:=co[i].stock_price;
end;
new(current^.next);
current:=current^.next;
current^.next:=NIL;
if num_rec>200 then begin
del_r(first_one);
end;
end;
with current^ do begin
thing:=0;
price:=stock_sum+player.cash;
end;
new(current^.next);
current:=current^.next;
current^.next:=NIL;
if num_rec>200 then begin
del_r(first_one);
end;
with current^ do begin
thing:=-99;
price:=dow_jones;
end;
new(current^.next);
current:=current^.next;
current^.next:=NIL;
if num_rec>200 then begin
del_r(first_one);
end;
inc(num_rec);
end;
procedure display;forward;
procedure _graph;
const
left=50;
var
grd,grm,c,i,divisor:integer;
tmp:dayptr;
s:string;
begin
s:='';
for c:=1 to num_co do with co[c] do begin
s:=s+symbol+',';
end;
s:=s+'Player,Dow Average';
s:=menu1(1,1,s);
for c:=1 to num_co do
if co[c].symbol=s then i:=c;
if s='Player' then i:=0;
if s='Dow Average' then i:=-99;
textattr:=7;
grd:=detect;
initgraph(grd,grm,'');
line(left,1,left,getmaxy);
for c:=getmaxy downto 1 do
if (c mod 20) = 0 then begin
str(c,s);
s:='$'+s;
outtextxy(1,getmaxy-c,s);
end;
for c:=getmaxx downto 1 do
if (c mod 50) = 0 then begin
str(round(c/1.2),s);
outtextxy(c,getmaxy-10,s);
end;
tmp:=first_one;
c:=0;
divisor:=1;
if i=0 then divisor:=20;
repeat
if tmp^.thing=i then begin
if c=0 then
moveto(c+left,(getmaxy-round(tmp^.price/divisor))) else
lineto(c+left,(getmaxy-round(tmp^.price/divisor)));
inc(c);
end;
tmp:=tmp^.next;
until tmp=NIL;
repeat until keypressed;
closegraph;
end;
procedure time_proc;
var
x,y:integer;
begin
x:=wherex;y:=wherey;
flash;
stock_window(3,4);
transact;
display;
date_add;
gotoxy(70,4);
write(memavail);
if universal_date.month<>cur_month then begin
earn;
cur_month:=universal_date.month;
end;
gotoxy(x,y);
end;
procedure transact;
var i:integer;
begin
for i:=1 to num_co do with co[i] do begin
if random(2)=0 then
stock_price:=stock_price+random(3) else
stock_price:=stock_price-random(3);
end;
end;
function priceof(s:string):real;
var i:integer;
begin
for i:=1 to num_co do
if co[i].symbol=s then priceof:=co[i].stock_price;
end;
function stock_sum:real;
var total:real;i:integer;
begin
total:=0;
with player do begin
for i:=1 to num_stock do
total:=total+(priceof(stock[i].symbol)*stock[i].shares)
end;
stock_sum:=total;
end;
procedure display;
begin
box(60,10,79,15);
gotoxy(61,11);
write('Cash=>',player.cash:7:2);
gotoxy(61,12);
write('Stock=>',stock_sum:7:2);
gotoxy(61,13);
write('Dow=>',dow_jones:7:2);
end;
procedure pbuy;
var s:string;
c,i:integer;
begin
s:='';
for c:=1 to num_co-1 do with co[c] do begin
s:=s+symbol+',';
end;
s:=s+co[num_co].symbol;
s:=menu1(1,1,s);
for c:=1 to num_co do
if co[c].symbol=s then begin
writeln;writeln;
writeln('How many shares?');
readln(i);
with player do
if (i*co[c].stock_price)<cash then begin
inc(num_stock);
stock[num_stock].shares:=i;
stock[num_stock].symbol:=s;
cash:=cash-(i*co[c].stock_price);
end;
end;
end;
procedure psell;
var s:string;
c,i:integer;
begin
with player do begin
s:='';
for c:=1 to num_stock do with stock[c] do begin
s:=s+symbol+',';
end;
s:=menu1(1,1,s);
for c:=1 to num_stock do
if stock[c].symbol=s then begin
writeln;writeln;
writeln('How many shares?');
readln(i);
if stock[c].shares<=i then begin
stock[c].shares:=stock[c].shares-i;
cash:=cash+(stock[c].shares*co[c].stock_price);
end;
end;
end;
end;
procedure init_play;
begin
player.cash:=5000;
player.num_stock:=0;
end;
procedure init_commands;
begin
box(1,17,30,25);
window(2,18,29,24);
gotoxy(1,1);
textattr:=2;
writeln('Commands:');
textattr:=7;
writeln('g-graph company,player,dow');
writeln('b-buy stock of company');
writeln('s-sell stock of company');
writeln('q-quit simulation');
window(1,1,80,25);
end;
label rep;
var
timer:word;
i:integer;
ch:char;
begin
textattr:=7;
randomize;
init;
init_stocks;
init_flash;
init_play;
rep:
clrscr;
gotoxy(50,20);
write('Command=>');
init_commands;
repeat
inc(timer);
if timer>2000 then begin
time_proc;
timer:=0;
end;
until keypressed;
ch:=readkey;
if ch='g' then _graph;
if ch='b' then pbuy;
if ch='s' then psell;
if ch='q' then else goto rep;
end.